home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: New Zealand Amiga Users Group / New Zealand Amiga Users Group Newsdisk v03 (1987-02)(NZAmigaUG).zip / New Zealand Amiga Users Group Newsdisk v03 (1987-02)(NZAmigaUG).adf / BASIC / Contour1 < prev    next >
Text File  |  1993-12-02  |  5KB  |  235 lines
  1. REM CONTOUR  18 Jan 1987               
  2.  
  3. REM  This is a simplified contour plotting program
  4. REM  for microcomputer--see BYTE Nov 1983 p487
  5. REM  Plots from file where row 0 & col 0 have centre
  6. REM  values of array elements.
  7.  
  8. DIM SHARED f(50,50)
  9. DIM SHARED c(20)
  10. INPUT "Name of file ";N$
  11. IF LEN(N$)<=1 GOTO fin
  12.  
  13. m0=-999
  14.  
  15. REM file read
  16.  
  17. getfile:
  18. REM el painful way to read in data, but it doesn't make too many assumptions!
  19. OPEN N$ FOR INPUT AS #1
  20. iMax=0:jMax=0
  21. FOR j=0 TO 50
  22.   p0=1:i=0
  23.   LINE INPUT #1,a$
  24.   a$=a$+" "
  25.   i1=LEN(a$)
  26.   IF i1<=1 GOTO done
  27.     fl=0
  28.     FOR p=1 TO i1
  29.       IF MID$(a$,p,1)<>" " THEN 
  30.         fl=1
  31.       ELSEIF fl<>0 THEN
  32.         f(i,j)=VAL(MID$(a$,p0,p-p0))
  33.         i=i+1:p0=p:fl=0
  34.       END IF
  35.     NEXT p
  36.     IF i>iMax THEN iMax=i-1
  37. NEXT j
  38. done:
  39. jMax=j-1
  40. CLOSE #1
  41.  
  42.  
  43. printarray:            
  44. FOR j=0 TO jMax         'J corresp to y-axis
  45.   FOR i=0 TO iMax       'I corresp to x-axis
  46.    x=f(i,j)
  47.    IF x=m0 THEN
  48.      PRINT "    ";
  49.    ELSE
  50.      PRINT USING "####";x;
  51.    END IF
  52.   NEXT i
  53.   PRINT
  54. NEXT j  
  55.  
  56. getsize:
  57. PRINT
  58. fMax=-1E+10:fMin=1E+10
  59. FOR j=1 TO jMax
  60.   FOR i=1 TO iMax
  61.     x=f(i,j)
  62.     IF fMax<x THEN fMax=x
  63.     IF fMin>x THEN fMin=x
  64.   NEXT i
  65. NEXT j  
  66.  
  67. setup:
  68. PRINT "highest=";fMax;"lowest=";fMin
  69. PRINT
  70. LINE INPUT "Name of X-scale " ; x$
  71. LINE INPUT "Name of Y-scale " ; y$
  72. INPUT "Min, Max X-scale to plot "; xMin, xMax
  73. INPUT "Min, Max Y-scale to plot "; yMin, yMax
  74. INPUT "How many contours " ; C1 : C1=C1+1
  75. c(1)=fMin-1 : x=(fMax-fMin)/C1
  76. FOR i=2 TO C1 : c(i)=c(i-1)+x : NEXT i
  77.  
  78. pr1:
  79. PRINT "Contour values :- ";
  80. FOR i=1 TO C1 : PRINT c(i); : NEXT i
  81. PRINT:PRINT "OK ? ";
  82. LINE INPUT a$ : a$=MID$(a$,1,1): IF a$<>"N" AND a$<>"n" GOTO pr2
  83. FOR i=1 TO C1
  84.   LINE INPUT "Contour?";a$
  85.   IF LEN(a$)>=1 THEN c(i)=VAL(a$)
  86. NEXT i
  87. GOTO pr1
  88.  
  89. pr2:  
  90. INPUT "X, Y Courseness [0..1]";s2,s3
  91.  
  92.  
  93. con:
  94. HCelSiz= (f(iMax,0) - f(1,0))/(iMax)
  95. VCelSiz=-(f(0,jMax) - f(0,1))/(jMax)
  96. xLo=INT(1+(xMin-f(1,0))/HCelSiz)
  97. xHi=INT(1+(xMax-f(1,0))/HCelSiz)
  98. yLo=jMax-INT((yMax-f(0,jMax))/VCelSiz)+1
  99. yHi=jMax-INT((yMin-f(0,jMax))/VCelSiz)+1
  100.  
  101. axis:   
  102.  
  103. CLS
  104.  
  105. Y0=(0-f(0,1))/(f(0,jMax)-f(0,1))
  106. IF xLo>=xHi THEN SWAP xLo,xHi
  107. IF yLo>=yHi THEN SWAP yLo,yHi
  108. sx= 550/(xHi-xLo)
  109. sy= 150/(yHi-yLo)
  110. xb=50 : yb= 16
  111.  
  112. LINE (50,170)-(50+(xHi-xLo)*sx,170),1
  113. LINE (50,170)-(50, 170-(yHi-yLo)*sy),1
  114. FOR i=1 TO (xHi-xLo)
  115.   LINE (50+i*sx,170) - (50+i*sx,165),1
  116. NEXT i
  117. FOR i=1 TO (yHi-yLo)
  118.   LINE (50,170-i*sy) - (55,170-i*sy),1
  119. NEXT i
  120.  
  121. LOCATE 20,30 : PRINT x$
  122. LOCATE 12,1 : PRINT y$
  123. FOR i=xLo TO xHi : LOCATE 23,5+(i-xLo)*sx/8 
  124.   IF i>0 AND i<=iMax THEN PRINT f(i,0);
  125. NEXT i
  126. FOR i=yLo TO yHi : LOCATE 22-(yHi-i)*sy/8, 3
  127.   IF i>0 AND i<=jMax THEN PRINT f(0,i); 
  128. NEXT i
  129. LOCATE 1,1
  130.  
  131. draw:
  132. CALL plot(xLo,xHi,yLo,yHi)
  133. END
  134.  
  135.  
  136.  
  137.  
  138. SUB plot(xLo,xHi,yLo,yHi) STATIC
  139.   SHARED iMax,jMax,sx,sy,s2,s3,m0,xb,yb,C1
  140.   c0 = c(1)
  141.   FOR i=xLo TO xHi
  142.     IF i<0 OR i>=iMax GOTO confin1
  143.     FOR j=yLo TO yHi
  144.       IF j<0 OR j>=jMax GOTO confin
  145.    
  146.       REM define 4 corners of a cell
  147.  
  148.       x1=f(i,j)
  149.       x2=f(i,j+1)  
  150.       x3=f(i+1,j)
  151.       x4=f(i+1,j+1)
  152.  
  153.       REM if all 4 corners are less than lowest contour or
  154.       REM any corner has a missing value,go to next cell
  155.  
  156.       IF x1<c0 AND x2<c0 AND x3<c0 AND x4<c0 GOTO confin
  157.       IF x1=m0 OR x2=m0 OR x3=m0 OR x4=m0 GOTO confin
  158.  
  159.       REM  I-direction interpolate over cell
  160.  
  161.       FOR k=0 TO 1-s2 STEP s2
  162.         z1=x1-k*(x1-x3)
  163.         z2=x2-k*(x2-x4)
  164.         IF z1<c0 AND z2<c0 GOTO con1
  165.         GOSUB cross
  166.  
  167.         REM CROSS gets subscripts of contours crossed
  168.  
  169.         IF c4<c3 GOTO con1
  170.         m=z2-z1
  171.         r2=i+k
  172.         b=z1-m*j
  173.  
  174.         REM find R1, the j-direction crossing coordinate
  175.  
  176.         FOR c5=c3 TO c4
  177.           r1=(c(c5)-b)/m
  178.           PSET ( sx*(r2-xLo)+xb,sy*(r1-yLo)+yb),(c5 MOD 3)+1 'corresp TO move+draw
  179.         NEXT c5
  180. con1:
  181.       NEXT k
  182.       REM      J-direction interpolate
  183.       FOR k=0 TO 1-s3 STEP s3
  184.         z1=x1-k*(x1-x2)
  185.         z2=x3-k*(x3-x4)
  186.         IF z1<c(1) AND z2<c(1) GOTO con2
  187.         GOSUB cross
  188.         IF c3>c4 GOTO con2
  189.         m=z2-z1
  190.         b=z1-m*i
  191.         r1=j+k
  192.         FOR c5=c3 TO c4
  193.           r2=(c(c5)-b)/m
  194.           PSET ( sx*(r2-xLo)+xb,sy*(r1-yLo)+yb),(c5 MOD 3)+1
  195.         NEXT c5
  196. con2: NEXT k
  197. confin:
  198.     NEXT j
  199. confin1:
  200.   NEXT i
  201.   PRINT "done"
  202.   GOTO fin
  203.  
  204.  
  205. cross:  'check FOR contour crossing between Z1 AND Z2
  206.   IF z1>z2 GOTO cross1
  207.   Y1=z1
  208.   Y2=z2
  209.   GOTO cross2
  210.  
  211. cross1:
  212.   Y1=z2
  213.   Y2=z1
  214.  
  215. cross2:
  216.   FOR c3=1 TO C1
  217.     IF Y1<c(c3) GOTO cross3
  218.   NEXT c3
  219.   c4=0
  220. RETURN
  221.  
  222. cross3:
  223.   FOR c4=c3 TO C1
  224.     IF Y2<=c(c4) GOTO cross4
  225.   NEXT c4
  226.  
  227. cross4:
  228.   c4=c4-1
  229. RETURN
  230.  
  231. fin:
  232. END SUB
  233.  
  234. END
  235.